home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacQForth 1.0 / documentation / Lessons / Answers next >
Encoding:
Text File  |  1995-03-24  |  7.6 KB  |  162 lines  |  [TEXT/ALFA]
  1.  
  2. Answers
  3. -------
  4.  
  5.    Answers to lesson exercises.  Try the exercises _before_ reading these!
  6.    (please...)
  7.    
  8.    
  9. ================================================================================
  10.  
  11.  
  12. Lesson 1
  13. --------
  14.  
  15. 1.1  : nip  ( a b -- b )        swap drop ;
  16. 1.2  : over ( a b -- a b a )    swap dup rot swap ;
  17. 1.3  : tuck ( a b -- b a b )    dup rot swap ;
  18. 1.4  : 2dup ( a b -- a b a b )  over over ;
  19.         or  swap dup rot swap  swap dup rot swap ;
  20.         
  21. 1.5  32 4 mod  55 55 * 102 / - 45 34 * 3 4 - 5 - / + .
  22. 1.6  1323 1023 102 45 / / /  3 2 9 * * 4 / mod .
  23.  
  24. 1.7  : ^2 ( a -- a^2 )  dup * ;
  25. 1.8  : ^3 ( a -- a^3 )  dup dup * * ;
  26. 1.9  : /mod ( a b -- a/b  (a mod b) )  2dup / rot rot swap mod ;
  27.      (or  swap dup rot swap  swap dup rot swap / rot rot swap mod ; )
  28.      (note: /mod is present in most forth systems                   )
  29.      
  30. 1.10  a)  Yes. SWAP places the 3 and the sum (34+23) in the correct order.
  31.       b)  No.  33 12 56 - + = 33+(12-56) <> 56 12 33 + - = 56-(12+33)
  32.       
  33. 1.11  The product 52 * 654 = 34008 which in a 16-bit Forth overflows and 
  34.       becomes -31528.  Then 1024 / gives -30.  Part (a) works because */ 
  35.       uses a 32-bit multiply preserving the 34008.
  36.  
  37.  
  38.  
  39.  
  40. Lesson 2
  41. --------
  42.  
  43. 2.1  : blast1 ( -- )  11 0 do  i . cr  loop  ." BLAST OFF!!!" cr ;
  44. 2.2  : blast2 ( -- )  -1 begin  1+ dup 11 <  while  dup . cr  repeat
  45.          drop  ." BLAST OFF!!!" cr ;
  46. 2.3  : blast3 ( -- )  0 begin  dup . cr  1+ dup 11 = until 
  47.          drop  ." BLAST OFF!!!" cr ;
  48.          
  49. 2.4  : typeKEY ( -- )
  50.          key
  51.          dup 13 = if  drop ." <CR>" cr  else
  52.          dup 27 = if  drop ." <ESC>"    else
  53.          dup 27 < if  ." <CTRL-" 64 + emit ." >"  else
  54.          dup 31 > if  emit              else
  55.            drop  then then then then ;
  56.            
  57. 2.5  : +CONST ( i0 i1 i2 k -- i0+k i1+k i2+k )
  58.          dup >r +  rot R@ +  rot r> +  rot  ;
  59.  
  60.  
  61.  
  62.  
  63. Lesson 3
  64. --------
  65.  
  66. 3.1  variable L
  67.      variable W
  68.      variable H
  69.      
  70.      : volLWH  ( -- )  L @ W @ H @ * * ;
  71.      
  72.      : SurArea ( -- )  L @ W @ * 2*  L @ H @ * 2*  W @ H @ * 2* + + ;
  73.      
  74.      : AVratio ( vol area -- vol/area vol mod area )  
  75.         dup >r swap dup r> /  rot rot  swap mod ;
  76.         
  77.      : VOLUME.STATS ( L W H -- )
  78.         H ! W ! L !
  79.         cr ." LENGTH = " L @ . ." m, WIDTH = " W @ . 
  80.         ." m, HEIGHT = " H @ . ." m" cr
  81.         cr ." VOLUME       = " volLWH dup  . ." cubic meters"
  82.         cr ." SURFACE AREA = " SurArea dup . ." square meters" cr
  83.         dup >r AVratio swap
  84.         cr ." RATIO VOLUME / SURFACE AREA = " .
  85.         dup 0= if  drop r> drop  else  ." and " . ." /" r> .  then cr ;
  86.  
  87.  
  88. 3.2  : { ;   ( make the code look nicer )
  89.      : x ;
  90.      
  91.      : MATRIX ( addr i j -- )  ( reserve room for the matrix and keep the )
  92.         over over ( 2dup )     ( indices in the first two locations       )
  93.         * 2* 4 + allot
  94.         rot dup >r 2+ ! r> ! ;
  95.      
  96.      : } ( addr i j -- address-of-i,j-th-element )
  97.         rot dup >r  @ rot *  +  2*  4 +  r> +  ;
  98.         
  99.  
  100. 3.3  : 2dup ( a b -- a b a b )  over over ;
  101.  
  102.      : M! ( 00 01 10 11 addr -- )  ( store values in a 2 x 2 matrix )
  103.         dup >r { 1 1 } !  R@ { 1 0 } !  R@ { 0 1 } !  r> { 0 0 } ! ;
  104.         
  105.      : M+ ( a b -- 00 01 10 11 )  ( add two 2 x 2 matrices )
  106.         2dup { 0 0 } @  swap { 0 0 } @ +  rot rot
  107.         2dup { 0 1 } @  swap { 0 1 } @ +  rot rot
  108.         2dup { 1 0 } @  swap { 1 0 } @ +  rot rot
  109.              { 1 1 } @  swap { 1 1 } @ +  ;
  110.      
  111.      : .M ( addr -- )  ( print a 2 x 2 matrix )
  112.         ." [[ " dup >r { 0 0 } @ . space R@ { 0 1 } @ . ." ],[ "
  113.         R@ { 1 0 } @ . space r> { 1 1 } @ . ." ]]" ;
  114.      
  115.  
  116. 3.4  variable addr  ( address of string )
  117.      variable len   ( length of string  )
  118.      : REVERSE ( addr len -- )  ( reverse a string )
  119.         len ! addr !
  120.         len @ 2/ 0 do                 ( swap outermost characters, then  )
  121.           addr @ i + c@               ( the next ones in, etc.           )
  122.           addr @ len @ + 1- i - c@
  123.           addr @ i + c!
  124.           addr @ len @ + 1- i - c!
  125.         loop ;             
  126.  
  127.  
  128.  
  129.  
  130. Lesson 4
  131. --------
  132.  
  133. ( Exercise 4.1 )
  134. ( Read 10 lines into a buffer and write the buffer to disk )
  135.  
  136. ( structures )
  137.  
  138. create BUFFER  10 80 * allot  ( room for 10 lines of up to 80 characters )
  139. create STR     80 allot       ( the input string                         )
  140.  
  141. variable ptr   ( point to the address for the beginning of the next line )
  142.  
  143. variable addr  ( for >buffer to make it clearer )
  144. variable len
  145.  
  146. ( definitions )
  147.  
  148. : input ( addr -- len )  ( put a string terminated with <cr> in addr )
  149.    dup >r        ( save the address )
  150.    79 expect cr  ( get the string leaving room for terminating <cr>   )
  151.    r> 13 swap span + c!  ( put in terminating <cr> )
  152.    span 1+   ; ( return length including <cr> )
  153.  
  154. : >buffer ( len addr -- )  ( copy into the buffer at current pointer )
  155.    addr !  len !   ( save values )
  156.    BUFFER ptr @ + len @ +  BUFFER ptr @ +  do   
  157.      addr @ i + BUFFER ptr @ + -  c@  ( get a character )
  158.      i c!                             ( save it in the buffer )
  159.    loop
  160.    ptr @ len @ +  ptr !  ;  ( bump pointer )
  161.  
  162. : getText ( -- )  ( read 10 l